initial_rows <- nrow(data_analysis)
data_prep <- data_analysis %>%
filter(Screen == "Message")
filtered_rows <- initial_rows - nrow(data_prep)
filtered_rows[1] 5389Analysis of Motivated Reasoning on Political Topics Using Issue Motives
Data Preparations
Load data
Filters
Important: Filter out the responses to the Question (Screen != Question) as we only model the truth ratings for now!
I also only want the political question topics.
data_pol <- data_prep %>%
filter(question_type == "political") %>%
mutate(question_topic = factor(question_topic,
levels = c("climate",
"gender",
"immigration",
"discrimination",
"adoption",
"punishment"))) %>%
droplevels()
levels(data_pol$question_topic)[1] "climate" "gender" "immigration" "discrimination" "adoption"
[6] "punishment" Data types
As we will model monotonic effects, we have to transform the issue_motive_strength variable into an ordered factor.
data_pol <- data_pol %>%
mutate(issue_motive_strength = factor(issue_motive_strength,
levels = c("Anti-strong",
"Anti-moderate",
"Neutral",
"Pro-moderate",
"Pro-strong"),
ordered = TRUE)) Fit m1.pol
m1.pol: response_proportion ~ issue_motive + (issue_motive | subj_idx) + (issue_motive | question_topic)
Check some settings:
print(contrasts(data_pol$issue_motive)) Neutral Pro
Anti 0 0
Neutral 1 0
Pro 0 1Set model formula
f_m1.pol <- bf(response_proportion ~ issue_motive +
(issue_motive | subj_idx) +
(issue_motive | question_topic), center = T)And fit the ordered beta regression:
m1.pol <- ordbetareg(formula = f_m1.pol,
data = data_pol,
coef_prior_mean = 0,
coef_prior_SD = 1.5,
intercept_prior_mean = 0,
intercept_prior_SD = 1.5,
extra_prior = set_prior("lkj(2)", class = "L"),
seed = bayes_seed,
chains=4,
iter=4000,
true_bounds = c(0, 1),
control = list(adapt_delta = 0.99,
max_treedepth = 12),
file = here(model_dir, "m1.pol"))Model checks
print(m1.pol) Family: ord_beta_reg
Links: mu = identity; phi = identity; cutzero = identity; cutone = identity
Formula: response_proportion ~ issue_motive + (issue_motive | subj_idx) + (issue_motive | question_topic)
Data: data (Number of observations: 3018)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~question_topic (Number of levels: 6)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.04 0.03 0.00 0.12 1.00
sd(issue_motiveNeutral) 0.11 0.10 0.00 0.37 1.00
sd(issue_motivePro) 0.07 0.06 0.00 0.23 1.00
cor(Intercept,issue_motiveNeutral) -0.02 0.41 -0.75 0.75 1.00
cor(Intercept,issue_motivePro) -0.09 0.41 -0.81 0.71 1.00
cor(issue_motiveNeutral,issue_motivePro) -0.05 0.41 -0.79 0.72 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 4177 4935
sd(issue_motiveNeutral) 3829 5104
sd(issue_motivePro) 3074 4665
cor(Intercept,issue_motiveNeutral) 9792 6518
cor(Intercept,issue_motivePro) 10532 6606
cor(issue_motiveNeutral,issue_motivePro) 9012 6641
~subj_idx (Number of levels: 504)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.26 0.04 0.19 0.33 1.00
sd(issue_motiveNeutral) 0.11 0.08 0.00 0.29 1.00
sd(issue_motivePro) 0.16 0.10 0.01 0.35 1.01
cor(Intercept,issue_motiveNeutral) -0.26 0.38 -0.84 0.56 1.00
cor(Intercept,issue_motivePro) -0.13 0.34 -0.67 0.62 1.00
cor(issue_motiveNeutral,issue_motivePro) 0.02 0.40 -0.74 0.75 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2495 4214
sd(issue_motiveNeutral) 2974 4721
sd(issue_motivePro) 698 1686
cor(Intercept,issue_motiveNeutral) 7463 6355
cor(Intercept,issue_motivePro) 2654 4218
cor(issue_motiveNeutral,issue_motivePro) 1783 3844
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -0.06 0.04 -0.13 0.01 1.00 9220 6396
issue_motiveNeutral 0.15 0.08 -0.01 0.30 1.00 7942 5526
issue_motivePro 0.36 0.06 0.26 0.47 1.00 7062 4912
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
phi 3.73 0.10 3.53 3.94 1.00 4251 5826
cutzero -3.66 0.12 -3.90 -3.43 1.00 12749 6566
cutone 2.03 0.02 1.98 2.07 1.00 11452 6473
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Posterior predictive check
pp_check_ordbeta(m1.pol, ndraws = 50)$discrete
$continuous
ggsave(here(dia_dir, "ppc_m1.pol.png"),
width = 12, height = 6)Model convergence
Check the trace and density plots.
mcmc_plot(m1.pol, type = 'trace')No divergences to plot.
ggsave(here(dia_dir, "trace_plot_m1.pol.png"),
width = 18, height = 14)mcmc_plot(m1.pol, type = 'dens')
ggsave(here(dia_dir, "density_plot_m1.pol.png"), width = 18, height = 14)Fit m2.pol
m2.pol: response_proportion ~ issue_motive_strength + (issue_motive_strength | subj_idx) + (issue_motive_strength | question_topic)
Set model formula
f_m2.pol <- bf(response_proportion ~
mo(issue_motive_strength) +
(mo(issue_motive_strength) | subj_idx) +
(mo(issue_motive_strength) | question_topic), center = T)And fit the ordered beta regression:
m2.pol <- ordbetareg(formula = f_m2.pol,
data = data_pol,
coef_prior_mean = 0,
coef_prior_SD = 1.5,
intercept_prior_mean = 0,
intercept_prior_SD = 1.5,
extra_prior = set_prior("lkj(2)", class = "L"),
seed = bayes_seed,
chains=4,
iter=4000,
true_bounds = c(0, 1),
control = list(adapt_delta = 0.99,
max_treedepth = 12),
file = here(model_dir, "m2.pol"))Model checks
print(m2.pol) Family: ord_beta_reg
Links: mu = identity; phi = identity; cutzero = identity; cutone = identity
Formula: response_proportion ~ mo(issue_motive_strength) + (mo(issue_motive_strength) | subj_idx) + (mo(issue_motive_strength) | question_topic)
Data: data (Number of observations: 3018)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~question_topic (Number of levels: 6)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.04 0.04 0.00 0.13 1.00 3264
sd(moissue_motive_strength) 0.02 0.02 0.00 0.06 1.00 3042
cor(Intercept,moissue_motive_strength) -0.12 0.45 -0.87 0.76 1.00 6820
Tail_ESS
sd(Intercept) 4306
sd(moissue_motive_strength) 4016
cor(Intercept,moissue_motive_strength) 5477
~subj_idx (Number of levels: 504)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.26 0.05 0.17 0.36 1.00 1547
sd(moissue_motive_strength) 0.05 0.03 0.00 0.12 1.01 368
cor(Intercept,moissue_motive_strength) -0.24 0.37 -0.76 0.64 1.00 1110
Tail_ESS
sd(Intercept) 2483
sd(moissue_motive_strength) 1182
cor(Intercept,moissue_motive_strength) 2533
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -0.10 0.05 -0.19 -0.01 1.00 5246 5822
moissue_motive_strength 0.12 0.02 0.09 0.15 1.00 5454 5007
Monotonic Simplex Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
moissue_motive_strength1[1] 0.19 0.09 0.02 0.37 1.00 3816 2699
moissue_motive_strength1[2] 0.23 0.11 0.04 0.46 1.00 4735 3589
moissue_motive_strength1[3] 0.30 0.12 0.07 0.55 1.00 5044 3227
moissue_motive_strength1[4] 0.28 0.10 0.08 0.47 1.00 6608 5220
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
phi 3.73 0.11 3.53 3.94 1.00 3072 3506
cutzero -3.66 0.12 -3.90 -3.41 1.00 7868 5492
cutone 2.03 0.02 1.98 2.07 1.00 7898 5646
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Posterior predictive check
pp_check_ordbeta(m2.pol, ndraws = 50)$discrete
$continuous
ggsave(here(dia_dir, "ppc_m2.pol.png"),
width = 12, height = 6)Model convergence
Check the trace and density plots:
mcmc_plot(m2.pol, type = 'trace')No divergences to plot.
ggsave(here(dia_dir, "trace_plot_m2.pol.png"),
width = 18, height = 14)mcmc_plot(m2.pol, type = 'dens')
ggsave(here(dia_dir, "density_plot_m2.pol.png"), width = 18, height = 14)Fit m3.pol
m3.pol: response_proportion ~ issue_motive * crt + (issue_motive | subj_idx) + (issue_motive | question_topic)
Set model formula
f_m3.pol <- bf(response_proportion ~ issue_motive * scale(crt_correct) +
(issue_motive | subj_idx) +
(issue_motive | question_topic), center = T)And fit the ordered beta regression:
m3.pol <- ordbetareg(formula = f_m3.pol,
data = data_pol,
coef_prior_mean = 0,
coef_prior_SD = 1.5,
intercept_prior_mean = 0,
intercept_prior_SD = 1.5,
extra_prior = set_prior("lkj(2)", class = "L"),
seed = bayes_seed,
chains=4,
iter=4000,
true_bounds = c(0, 1),
control = list(adapt_delta = 0.99,
max_treedepth = 12),
file = here(model_dir, "m3.pol"))Model checks
print(m3.pol) Family: ord_beta_reg
Links: mu = identity; phi = identity; cutzero = identity; cutone = identity
Formula: response_proportion ~ issue_motive * scale(crt_correct) + (issue_motive | subj_idx) + (issue_motive | question_topic)
Data: data (Number of observations: 3018)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~question_topic (Number of levels: 6)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.04 0.04 0.00 0.13 1.00
sd(issue_motiveNeutral) 0.12 0.11 0.01 0.39 1.00
sd(issue_motivePro) 0.07 0.06 0.00 0.23 1.00
cor(Intercept,issue_motiveNeutral) -0.02 0.41 -0.77 0.75 1.00
cor(Intercept,issue_motivePro) -0.11 0.41 -0.82 0.70 1.00
cor(issue_motiveNeutral,issue_motivePro) -0.05 0.40 -0.78 0.72 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 3274 3939
sd(issue_motiveNeutral) 2991 4485
sd(issue_motivePro) 2656 4265
cor(Intercept,issue_motiveNeutral) 7403 5520
cor(Intercept,issue_motivePro) 8284 6537
cor(issue_motiveNeutral,issue_motivePro) 7339 6879
~subj_idx (Number of levels: 504)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.26 0.04 0.19 0.33 1.00
sd(issue_motiveNeutral) 0.11 0.08 0.00 0.28 1.00
sd(issue_motivePro) 0.17 0.10 0.01 0.36 1.01
cor(Intercept,issue_motiveNeutral) -0.24 0.38 -0.84 0.60 1.00
cor(Intercept,issue_motivePro) -0.14 0.33 -0.67 0.59 1.00
cor(issue_motiveNeutral,issue_motivePro) 0.01 0.40 -0.74 0.76 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2521 4452
sd(issue_motiveNeutral) 2332 3525
sd(issue_motivePro) 522 1689
cor(Intercept,issue_motiveNeutral) 6419 5721
cor(Intercept,issue_motivePro) 1859 4136
cor(issue_motiveNeutral,issue_motivePro) 1363 2285
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
Intercept -0.06 0.04 -0.13 0.01 1.00 7903
issue_motiveNeutral 0.15 0.08 -0.02 0.31 1.00 6028
issue_motivePro 0.36 0.06 0.25 0.47 1.00 6099
scalecrt_correct 0.06 0.03 0.01 0.12 1.00 7155
issue_motiveNeutral:scalecrt_correct -0.06 0.05 -0.16 0.04 1.00 9562
issue_motivePro:scalecrt_correct -0.06 0.04 -0.14 0.01 1.00 9046
Tail_ESS
Intercept 6104
issue_motiveNeutral 4384
issue_motivePro 3764
scalecrt_correct 5829
issue_motiveNeutral:scalecrt_correct 6818
issue_motivePro:scalecrt_correct 6431
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
phi 3.73 0.11 3.53 3.94 1.00 3501 4900
cutzero -3.66 0.12 -3.91 -3.43 1.00 10447 6210
cutone 2.03 0.02 1.98 2.07 1.00 9703 6037
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Posterior predictive check
pp_check_ordbeta(m3.pol, ndraws = 50)$discrete
$continuous
ggsave(here(dia_dir, "ppc_m3.pol.png"),
width = 12, height = 6)Model convergence
Check the trace and density plots:
mcmc_plot(m3.pol, type = 'trace')No divergences to plot.
ggsave(here(dia_dir, "trace_plot_m3.pol.png"),
width = 18, height = 14)mcmc_plot(m3.pol, type = 'dens')
ggsave(here(dia_dir, "density_plot_m3.pol.png"), width = 18, height = 14)Fit m4.pol
m4.pol: response_proportion ~ issue_motive * commission_errors_r + (issue_motive | subj_idx) + (issue_motive | question_topic)
Set model formula
f_m4.pol <- bf(response_proportion ~ issue_motive * scale(commission_errors_r) +
(issue_motive | subj_idx) +
(issue_motive | question_topic), center = T)And fit the ordered beta regression:
m4.pol <- ordbetareg(formula = f_m4.pol,
data = data_pol,
coef_prior_mean = 0,
coef_prior_SD = 1.5,
intercept_prior_mean = 0,
intercept_prior_SD = 1.5,
extra_prior = set_prior("lkj(2)", class = "L"),
seed = bayes_seed,
chains=4,
iter=4000,
true_bounds = c(0, 1),
control = list(adapt_delta = 0.99,
max_treedepth = 12),
file = here(model_dir, "m4.pol"))Model checks
print(m4.pol) Family: ord_beta_reg
Links: mu = identity; phi = identity; cutzero = identity; cutone = identity
Formula: response_proportion ~ issue_motive * scale(commission_errors_r) + (issue_motive | subj_idx) + (issue_motive | question_topic)
Data: data (Number of observations: 3018)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~question_topic (Number of levels: 6)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.04 0.04 0.00 0.13 1.00
sd(issue_motiveNeutral) 0.12 0.11 0.01 0.38 1.00
sd(issue_motivePro) 0.08 0.06 0.00 0.24 1.00
cor(Intercept,issue_motiveNeutral) -0.02 0.41 -0.76 0.75 1.00
cor(Intercept,issue_motivePro) -0.10 0.41 -0.81 0.71 1.00
cor(issue_motiveNeutral,issue_motivePro) -0.06 0.41 -0.78 0.72 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 3469 3781
sd(issue_motiveNeutral) 2811 3847
sd(issue_motivePro) 2845 3900
cor(Intercept,issue_motiveNeutral) 7891 6521
cor(Intercept,issue_motivePro) 7000 5416
cor(issue_motiveNeutral,issue_motivePro) 7028 6311
~subj_idx (Number of levels: 504)
Estimate Est.Error l-95% CI u-95% CI Rhat
sd(Intercept) 0.26 0.04 0.19 0.33 1.00
sd(issue_motiveNeutral) 0.11 0.08 0.00 0.28 1.00
sd(issue_motivePro) 0.16 0.10 0.01 0.35 1.00
cor(Intercept,issue_motiveNeutral) -0.25 0.38 -0.84 0.59 1.00
cor(Intercept,issue_motivePro) -0.15 0.33 -0.68 0.60 1.00
cor(issue_motiveNeutral,issue_motivePro) 0.01 0.40 -0.74 0.74 1.00
Bulk_ESS Tail_ESS
sd(Intercept) 2185 4304
sd(issue_motiveNeutral) 1931 3142
sd(issue_motivePro) 524 1542
cor(Intercept,issue_motiveNeutral) 5700 5643
cor(Intercept,issue_motivePro) 1869 3233
cor(issue_motiveNeutral,issue_motivePro) 1381 2613
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat
Intercept -0.06 0.04 -0.13 0.01 1.00
issue_motiveNeutral 0.16 0.09 -0.01 0.31 1.00
issue_motivePro 0.36 0.06 0.26 0.47 1.00
scalecommission_errors_r -0.02 0.03 -0.08 0.03 1.00
issue_motiveNeutral:scalecommission_errors_r 0.05 0.05 -0.05 0.16 1.00
issue_motivePro:scalecommission_errors_r 0.02 0.04 -0.05 0.10 1.00
Bulk_ESS Tail_ESS
Intercept 6658 5513
issue_motiveNeutral 4963 3893
issue_motivePro 5756 4480
scalecommission_errors_r 5489 5715
issue_motiveNeutral:scalecommission_errors_r 8118 5613
issue_motivePro:scalecommission_errors_r 7667 5715
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
phi 3.73 0.11 3.53 3.94 1.00 2706 4211
cutzero -3.66 0.12 -3.91 -3.42 1.00 8265 5925
cutone 2.03 0.02 1.98 2.07 1.00 8656 6312
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Posterior predictive check
pp_check_ordbeta(m4.pol, ndraws = 50)$discrete
$continuous
ggsave(here(dia_dir, "ppc_m4.pol.png"),
width = 12, height = 6)Model convergence
Check the trace and density plots:
mcmc_plot(m4.pol, type = 'trace')No divergences to plot.
ggsave(here(dia_dir, "trace_plot_m4.pol.png"),
width = 18, height = 14)mcmc_plot(m4.pol, type = 'dens')
ggsave(here(dia_dir, "density_plot_m4.pol.png"), width = 18, height = 14)Fit m5.pol
m5.pol: response_proportion ~ issue_motive_strength * crt + (issue_motive_strength | subj_idx) + (issue_motive_strength | question_topic)
Set model formula
f_m5.pol <- bf(response_proportion ~ mo(issue_motive_strength) * scale(crt_correct) +
(mo(issue_motive_strength) | subj_idx) +
(mo(issue_motive_strength) | question_topic), center = T)And fit the ordered beta regression:
m5.pol <- ordbetareg(formula = f_m5.pol,
data = data_pol,
coef_prior_mean = 0,
coef_prior_SD = 1.5,
intercept_prior_mean = 0,
intercept_prior_SD = 1.5,
extra_prior = set_prior("lkj(2)", class = "L"),
seed = bayes_seed,
chains=4,
iter=4000,
true_bounds = c(0, 1),
control = list(adapt_delta = 0.99,
max_treedepth = 12),
file = here(model_dir, "m5.pol"))Model checks
print(m5.pol) Family: ord_beta_reg
Links: mu = identity; phi = identity; cutzero = identity; cutone = identity
Formula: response_proportion ~ mo(issue_motive_strength) * scale(crt_correct) + (mo(issue_motive_strength) | subj_idx) + (mo(issue_motive_strength) | question_topic)
Data: data (Number of observations: 3018)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~question_topic (Number of levels: 6)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.04 0.04 0.00 0.13 1.00 3355
sd(moissue_motive_strength) 0.02 0.02 0.00 0.06 1.00 3287
cor(Intercept,moissue_motive_strength) -0.12 0.45 -0.87 0.75 1.00 7042
Tail_ESS
sd(Intercept) 3218
sd(moissue_motive_strength) 4052
cor(Intercept,moissue_motive_strength) 5382
~subj_idx (Number of levels: 504)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.26 0.05 0.16 0.35 1.00 1574
sd(moissue_motive_strength) 0.06 0.03 0.00 0.12 1.01 373
cor(Intercept,moissue_motive_strength) -0.21 0.37 -0.74 0.64 1.00 1085
Tail_ESS
sd(Intercept) 2802
sd(moissue_motive_strength) 1276
cor(Intercept,moissue_motive_strength) 2709
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat
Intercept -0.10 0.04 -0.19 -0.02 1.00
scalecrt_correct 0.08 0.04 0.01 0.16 1.00
moissue_motive_strength 0.12 0.02 0.09 0.15 1.00
moissue_motive_strength:scalecrt_correct -0.02 0.01 -0.05 0.00 1.00
Bulk_ESS Tail_ESS
Intercept 4920 5939
scalecrt_correct 6143 5841
moissue_motive_strength 5560 5099
moissue_motive_strength:scalecrt_correct 6756 6202
Monotonic Simplex Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat
moissue_motive_strength1[1] 0.20 0.09 0.02 0.38 1.00
moissue_motive_strength1[2] 0.23 0.11 0.03 0.46 1.00
moissue_motive_strength1[3] 0.30 0.12 0.08 0.55 1.00
moissue_motive_strength1[4] 0.28 0.10 0.08 0.46 1.00
moissue_motive_strength:scalecrt_correct1[1] 0.34 0.21 0.02 0.77 1.00
moissue_motive_strength:scalecrt_correct1[2] 0.25 0.19 0.01 0.68 1.00
moissue_motive_strength:scalecrt_correct1[3] 0.21 0.17 0.01 0.63 1.00
moissue_motive_strength:scalecrt_correct1[4] 0.20 0.16 0.01 0.60 1.00
Bulk_ESS Tail_ESS
moissue_motive_strength1[1] 4238 2843
moissue_motive_strength1[2] 5042 2812
moissue_motive_strength1[3] 6836 4277
moissue_motive_strength1[4] 7030 4521
moissue_motive_strength:scalecrt_correct1[1] 7942 4479
moissue_motive_strength:scalecrt_correct1[2] 10018 5115
moissue_motive_strength:scalecrt_correct1[3] 9986 5518
moissue_motive_strength:scalecrt_correct1[4] 10004 5159
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
phi 3.73 0.10 3.53 3.93 1.00 2772 4957
cutzero -3.66 0.12 -3.91 -3.43 1.00 9356 5841
cutone 2.03 0.02 1.98 2.07 1.00 9515 6347
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Posterior predictive check
pp_check_ordbeta(m5.pol, ndraws = 50)$discrete
$continuous
ggsave(here(dia_dir, "ppc_m5.pol.png"),
width = 12, height = 6)Model convergence
Check the trace and density plots:
mcmc_plot(m5.pol, type = 'trace')No divergences to plot.
ggsave(here(dia_dir, "trace_plot_m5.pol.png"),
width = 18, height = 14)mcmc_plot(m5.pol, type = 'dens')
ggsave(here(dia_dir, "density_plot_m5.pol.png"), width = 18, height = 14)Fit m6.pol
m6.pol: response_proportion ~ issue_motive_strength * commission_errors_r + (issue_motive_strength | subj_idx) + (issue_motive_strength | question_topic)
Set model formula
f_m6.pol <- bf(response_proportion ~ mo(issue_motive_strength) * scale(commission_errors_r) +
(mo(issue_motive_strength) | subj_idx) +
(mo(issue_motive_strength) | question_topic), center = T)And fit the ordered beta regression:
m6.pol <- ordbetareg(formula = f_m6.pol,
data = data_pol,
coef_prior_mean = 0,
coef_prior_SD = 1.5,
intercept_prior_mean = 0,
intercept_prior_SD = 1.5,
extra_prior = set_prior("lkj(2)", class = "L"),
seed = bayes_seed,
chains=4,
iter=4000,
true_bounds = c(0, 1),
control = list(adapt_delta = 0.99,
max_treedepth = 12),
file = here(model_dir, "m6.pol"))Model checks
print(m6.pol) Family: ord_beta_reg
Links: mu = identity; phi = identity; cutzero = identity; cutone = identity
Formula: response_proportion ~ mo(issue_motive_strength) * scale(commission_errors_r) + (mo(issue_motive_strength) | subj_idx) + (mo(issue_motive_strength) | question_topic)
Data: data (Number of observations: 3018)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~question_topic (Number of levels: 6)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.04 0.04 0.00 0.13 1.00 4001
sd(moissue_motive_strength) 0.02 0.02 0.00 0.06 1.00 3205
cor(Intercept,moissue_motive_strength) -0.12 0.45 -0.88 0.76 1.00 7839
Tail_ESS
sd(Intercept) 4171
sd(moissue_motive_strength) 4152
cor(Intercept,moissue_motive_strength) 6188
~subj_idx (Number of levels: 504)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.26 0.05 0.17 0.36 1.00 1557
sd(moissue_motive_strength) 0.05 0.03 0.00 0.12 1.01 373
cor(Intercept,moissue_motive_strength) -0.22 0.38 -0.76 0.66 1.00 1150
Tail_ESS
sd(Intercept) 3076
sd(moissue_motive_strength) 1166
cor(Intercept,moissue_motive_strength) 2696
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI
Intercept -0.10 0.04 -0.19 -0.02
scalecommission_errors_r -0.02 0.03 -0.09 0.04
moissue_motive_strength 0.12 0.02 0.09 0.15
moissue_motive_strength:scalecommission_errors_r 0.01 0.01 -0.01 0.03
Rhat Bulk_ESS Tail_ESS
Intercept 1.00 5728 5919
scalecommission_errors_r 1.00 5594 5863
moissue_motive_strength 1.00 5800 5767
moissue_motive_strength:scalecommission_errors_r 1.00 5828 6106
Monotonic Simplex Parameters:
Estimate Est.Error l-95% CI u-95% CI
moissue_motive_strength1[1] 0.20 0.09 0.03 0.38
moissue_motive_strength1[2] 0.22 0.11 0.03 0.46
moissue_motive_strength1[3] 0.30 0.12 0.08 0.54
moissue_motive_strength1[4] 0.28 0.10 0.08 0.47
moissue_motive_strength:scalecommission_errors_r1[1] 0.29 0.21 0.01 0.75
moissue_motive_strength:scalecommission_errors_r1[2] 0.25 0.19 0.01 0.70
moissue_motive_strength:scalecommission_errors_r1[3] 0.23 0.19 0.01 0.70
moissue_motive_strength:scalecommission_errors_r1[4] 0.22 0.19 0.01 0.68
Rhat Bulk_ESS Tail_ESS
moissue_motive_strength1[1] 1.00 5153 3686
moissue_motive_strength1[2] 1.00 5951 4210
moissue_motive_strength1[3] 1.00 7373 5224
moissue_motive_strength1[4] 1.00 7636 4973
moissue_motive_strength:scalecommission_errors_r1[1] 1.00 9777 4341
moissue_motive_strength:scalecommission_errors_r1[2] 1.00 11881 5358
moissue_motive_strength:scalecommission_errors_r1[3] 1.00 11565 5808
moissue_motive_strength:scalecommission_errors_r1[4] 1.00 8820 5395
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
phi 3.73 0.10 3.53 3.93 1.00 2733 5073
cutzero -3.66 0.12 -3.90 -3.43 1.00 9236 6541
cutone 2.03 0.02 1.98 2.07 1.00 8371 6208
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Posterior predictive check
pp_check_ordbeta(m5.pol, ndraws = 50)$discrete
$continuous
ggsave(here(dia_dir, "ppc_m6.pol.png"),
width = 12, height = 6)Model convergence
Check the trace and density plots:
mcmc_plot(m6.pol, type = 'trace')No divergences to plot.
ggsave(here(dia_dir, "trace_plot_m6.pol.png"),
width = 18, height = 14)mcmc_plot(m6.pol, type = 'dens')
ggsave(here(dia_dir, "density_plot_m6.pol.png"), width = 18, height = 14)